The 640 MEG Shareware Studio 2/The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO/virus/stelth22.zip/VIRCHECK.PAS

Pascal/Delphi Source File | 1992-02-10 | 11KB | 457 lines

{$I-}
{
vircheck.pas
Stealth Bomber Version 2.2

Kevin Dean
Fairview Mall P.O. Box 55074
1800 Sheppard Avenue East
Willowdale, Ontario
CANADA    M2J 5B9
CompuServe ID: 76336,3114

February 10, 1992

    This is the interface to the anti-virus system and CRC checks in the
Stealth Bomber package.

    This code is public domain.
}


unit VirCheck;


interface


uses
  DOS, DOSMCB, AllocBuf;


type
  crc32_t =
    longint;

  FileCRC =
    record
    case boolean of
      false:
    (
    SearchStr : array [1 .. 8] of char;    { Used by Stealth Bomber package only. }
    );

      true:
    (
    Polynomial : crc32_t;            { Polynomial for this file. }
    CRC : crc32_t;                { Calculated CRC for this file. }
    );
    end;


{ Anti-virus validation return code. }
const
  StealthOK          = $0000;    { No virus found. }
  StealthIntrErr     = $0001;    { Interrupts set beyond the program's code space. }
  StealthDOSMemErr   = $0002;    { DOS memory inconsistent with BIOS memory. }
  StealthDOSHijacked = $0004;    { DOS interrupt hijacked by JMP FAR or CALL FAR. }
  StealthFileErr     = $0001;    { File not found or unable to open. }
  StealthFileDateErr = $0002;    { File date/time stamp invalid. }
  StealthFileSizeErr = $0004;    { File size inconsistent between directory and file open checks. }
  StealthCRCBadPoly  = $0008;    { CRC polynomial is invalid. }
  StealthNoMem       = $0010;    { No memory to perform CRC check. }
  StealthCRCInvalid  = $0020;    { CRC is invalid. }


function StealthSysCheck : word;
function StealthFileCheck(FileName : PathStr; FCRC : FileCRC) : word;


implementation


type
  dWordRec =
    record
    Lo, Hi : word
    end;

  BytePtr =
    ^byte;

  WordPtr =
    ^word;

  PtrPtr =
    ^pointer;


{***}
function BIOSMemory : word;

var
  Regs : Registers;    { Registers in memory check call. }

begin
Intr($12, Regs);
BIOSMemory := Regs.AX;
end;


{***}
{ Determine true segment address of pointer and check for wrap around memory. }
function PtrSeg(Ptr : pointer) : word;

var
  PSeg : word;    { True segment of pointer. }

begin
PSeg := Seg(Ptr^) + Ofs(Ptr^) shr 4;

if PSeg < Seg(Ptr^) then
  { Pointer points beyond standard 1M memory. }
  PSeg := $FFFF;

PtrSeg := PSeg;
end;


{***}
{ Validate interrupt; make sure not beyond code space and not hijacked. }
function ValidateIntr(IntrNum : integer; MemLimit : word) : word;

var
  Result : word;        { Result of tests. }
  I : record
      case boolean of
    false:
      (
      IPtr : pointer;    { Interrupt pointer. }
      );

    true:
      (
      CodePtr : BytePtr;    { Pointer to interrupt; treat as data. }
      );
      end;
  ISeg : word;            { Adjusted segment of I.IPtr. }
  Target : pointer;        { Target of hijacked interrupt. }
  IntrMCB : MCBPtr;        { MCB of hijacked interrupt. }
  TargetMCB : MCBPtr;        { MCB of target of hijacking. }

begin
{ Assume interrupt is valid. }
Result := StealthOK;

{ Get interrupt and adjusted segment. }
GetIntVec(IntrNum, I.IPtr);
ISeg := PtrSeg(I.IPtr);

{ Interrupt pointer invalid if between PSP and memory limit. }
if (ISeg >= PrefixSeg) and (ISeg < MemLimit) then
  Result := Result or StealthIntrErr;

{ Check beginning of interrupt code for suspicious instructions. }
case I.CodePtr^ of
  $EA,        { JMP FAR <addr>. }
  $9A:        { CALL FAR <addr>. }
    begin
    Target := PtrPtr(longint(I.CodePtr) + 1)^;
    Result := Result or StealthDOSHijacked;
    end;

  $2E:        { CS segment prefix. }
    case WordPtr(longint(I.CodePtr) + 1)^ of
      $2EFF,    { JMP FAR CS:[addr]. }
      $1EFF:    { CALL FAR CS:[addr]. }
    begin
    Target := PtrPtr(Ptr(Seg(I.CodePtr^), WordPtr(longint(I.CodePtr) + 3)^))^;
    Result := Result or StealthDOSHijacked;
    end;
      end;
  end;

if Result and StealthDOSHijacked <> 0 then
  begin
  { Determine MCB's that own the interrupt and the target of the redirection. }
  IntrMCB := MCBOwner(I.CodePtr);
  TargetMCB := MCBOwner(Target);

  { Redirection is valid if it falls within the same MCB or falls outside memory limit. }
  if (IntrMCB = TargetMCB) or (PtrSeg(target) >= MemLimit) then
    Result := Result and not StealthDOSHijacked;
  end;

ValidateIntr := Result;
end;


{***}
{ Perform anti-virus system check. }
function StealthSysCheck : word;

var
  Result : word;    { Result of tests. }
  MCB : MCBPtr;        { Memory control block pointer. }
  BIOSMem : word;    { Memory in paragraphs according to BIOS. }
  DOSMem : word;    { Memory in paragraphs according to DOS. }
  MemLimit : word;    { Limit of useable memory. }

begin
{ Assume system passes all tests. }
Result := StealthOK;

BIOSMem := BIOSMemory * 64;

{ Find last memory control block. }
MCB := GetMCB;
while MCB^.ID <> $5A do
  MCB := NextMCB(MCB);

DOSMem := Seg(MCB^) + MCB^.Size + 1;

{ DOS memory extenders may show more memory than BIOS and some versions of DOS may differ by up to 1k from BIOS memory. }
if BIOSMem > DOSMem + 64 then
  Result := Result or StealthDOSMemErr;

{ Assume BIOS memory goes at least to 640k limit (may have been modified by virus). }
if BIOSMem < $A000 then
  MemLimit := $A000
else
  MemLimit := BIOSMem;
if MemLimit < DOSMem then
  MemLimit := DOSMem;

{ Swap vectors taken over by Turbo Pascal. }
SwapVectors;

Result := Result or ValidateIntr($21, MemLimit);    { DOS function interrupt. }
Result := Result or ValidateIntr($24, MemLimit);    { Critical error interrupt. }
Result := Result or ValidateIntr($25, MemLimit);    { Absolute disk read interrupt. }
Result := Result or ValidateIntr($26, MemLimit);    { Absolute disk write interrupt. }
Result := Result or ValidateIntr($1C, MemLimit);    { User timer interrupt. }
Result := Result or ValidateIntr($28, MemLimit);    { DOS OK interrupt. }

{ Restore vectors required by Turbo Pascal. }
SwapVectors;

StealthSysCheck := Result;
end;


{***}
{ Extract the low word of a dword. }
function LowW(DWord : longint) : word;

begin
LowW := DWordRec(DWord).Lo;
end;


{***}
{ Extract the high word of a dword. }
function HiW(DWord : longint) : word;

begin
HiW := DWordRec(DWord).Hi;
end;


{***}
{ Calculate the CRC of a file.  The file is assumed to be open and the buffer is assumed to be valid. }
function CalcCRC(var F : file; Buffer : BytePtr; BufSize : word; Polynomial : crc32_t) : crc32_t;

var
  Table : array [0 .. 255] of crc32_t;    { CRC table. }
  I : word;                { Byte counter. }
  HalfI : ^crc32_t;            { Pointer to CRC of I div 2. }
  CRC : crc32_t;            { Current CRC. }
  BufPtr : BytePtr;            { Pointer to walk through Buffer. }

begin
{ Generate a CRC lookup table for faster calculation. }
I := 0;
HalfI := @Table[0];
Table[0] := 0;
while I < 256 do
  begin
  if Hi(HiW(HalfI^)) and $80 <> $00 then
    begin
    Table[I + 1] := HalfI^ shl 1;
    Table[I] := Table[I + 1] xor Polynomial;
    end
  else
    begin
    Table[I] := HalfI^ shl 1;
    Table[I + 1] := Table[I] xor Polynomial;
    end;

  Inc(I, 2);
  Inc(longint(HalfI), sizeof(crc32_t));
  end;

{ Calculate CRC. }
CRC := 0;
BlockRead(F, Buffer^, BufSize, I);
while I <> 0 do
  begin
  BufPtr := Buffer;
  while I <> 0 do
    begin
    CRC := (CRC shl 8) xor Table[Hi(HiW(CRC)) xor BufPtr^];

    Dec(I);
    Inc(longint(BufPtr));
    end;

  BlockRead(F, Buffer^, BufSize, I);
  end;

CalcCRC := CRC;
end;


{***}
{ Check file header consistency and calculate CRC of file. }
function StealthFileCheck(FileName : PathStr; FCRC : FileCRC) : word;

var
  Result : word;    { Result of tests. }

  FN : PathStr;        { Complete file name with path. }
  Dir : DirStr;        { Directory of ParamStr(0). }
  Name : NameStr;    { Name of ParamStr(0). }
  Ext : ExtStr;        { Extension of ParamStr(0). }

  DirInfo : SearchRec;    { File directory information. }
  TimeStamp : DateTime;    { Time stamp within DirInfo. }

  OldFileMode : byte;    { Old file open mode. }
  F : file;        { File handle for FN. }

  Buffer : BytePtr;    { Buffer for file's data. }
  BufSize : word;    { Buffer size. }

begin
{ Assume file passes all tests. }
Result := StealthOK;

{ If name contains drive or directory, use unmodified, else build full name. }
if (FileName[2] = ':') or (Pos('\', FileName) <> 0) then
  FN := FileName
else
  begin
  { Assume file not found. }
  FN := '';

  { DOS version 3 and above save program name in ParamStr(0). }
  if Lo(DOSVersion) >= 3 then
    begin
    { Split program name into its components. }
    FN := ParamStr(0);
    FSplit(FN, Dir, Name, Ext);

    { Merge drive and directory with file name. }
    FN := Dir + FileName;

    { Attempt to access file; if failed, pass control onto path search. }
    FindFirst(FN, ReadOnly or Hidden or SysFile or Archive, DirInfo);
    if DosError <> 0 then
      FN := '';
    end;
  end;

if FN = '' then
  { Search path for file. }
  FN := FSearch(FileName, GetEnv('PATH'));

if FN <> '' then
  begin
  FindFirst(FN, ReadOnly or Hidden or SysFile or Archive, DirInfo);
  if DosError = 0 then
    begin
    UnpackTime(DirInfo.Time, TimeStamp);

    { Check file time, day, and year. }
    if (TimeStamp.Sec > 59) or (TimeStamp.Min > 59) or (TimeStamp.Hour > 23) or
       (TimeStamp.Day = 0) or (TimeStamp.Year >= 2080) then
      Result := Result or StealthFileDateErr;

    case TimeStamp.Month of
      4, 6, 9, 11:
    { Thirty days hath September, April, June, and November. }
    if TimeStamp.Day > 30 then
      Result := Result or StealthFileDateErr;

      1, 3, 5, 7, 8, 10, 12:
    { All the rest have thirty-one, excepting February alone. }
    if TimeStamp.Day > 31 then
      Result := Result or StealthFileDateErr;

      2:
    { February hath twenty-eight days clear, and twenty-nine in each leap year. }
    if TimeStamp.Year mod 4 <> 0 then
      begin
      if TimeStamp.Day > 28 then
        Result := Result or StealthFileDateErr;
      end
    else
      if TimeStamp.Day > 29 then
        Result := Result or StealthFileDateErr;

      else
        Result := Result or StealthFileDateErr;
      end;

    { Save and set file mode to read-only. }
    OldFileMode := FileMode;
    FileMode := 0;

    Assign(F, FN);
    Reset(F, 1);

    { Restore file mode. }
    FileMode := OldFileMode;

    if IOResult = 0 then
      begin
      { Compare length to length returned by directory search. }
      if FileSize(F) <> DirInfo.Size then
    Result := Result or StealthFileSizeErr;

      { Make sure that polynomial has its last bit and at least one other set. }
      if (FCRC.Polynomial and $00000001 = 0) or (FCRC.Polynomial = $00000001) then
    Result := Result or StealthCRCBadPoly;

      { Allocate 16k buffer if possible, but get at least 512 bytes. }
      BufSize := 16384;
      Buffer := BufAlloc(BufSize, 512);

      if Buffer <> nil then
    begin
    { CRC is valid if calculated CRC matches what is stored in FCRC. }
    if FCRC.CRC <> CalcCRC(F, Buffer, BufSize, FCRC.Polynomial) then
      Result := Result or StealthCRCInvalid;

    FreeMem(Buffer, BufSize);
    end
      else
    Result := Result or StealthNoMem;

      Close(F);
      end
    else
      Result := Result or StealthFileErr;
    end
  else
    Result := Result or StealthFileErr;
  end
else
  Result := Result or StealthFileErr;

StealthFileCheck := Result;
end;


end.